Raport przedstawia analizę możliwych przyczyn karłowacenia śledzia oceanicznego wyławianego w Europie.

Executive summary

Jest wiele powodów, dlaczego śledzie oceaniczne w Europie maleją. Poniższy raport przedstawia najbardziej prawdopodobne hipotezy, opierając się na zebranych danych. Zmiana temperatury przy powierzchni wody oraz intensywność połowów przez człowieka okazały się najbardziej istotne. Zaprezentowany w analizie regresor dobrze poradził sobie z zadaniem. Model pozwala w zadowalający sposób przewidzieć długość śledzia dla danych wartości atrybutów. W celu uzyskania bardziej obiektywnych rezultatów analizy, należałoby zebrać więcej obserwacji oraz uzupełnić je o czas pomiaru oraz dodatkowe atrybuty. Jakość pomiarów w wielu przypadkach nie jest również odpowiednio dokładna, ponieważ większość atrybutów posiada jedynie około 50 różnych wartości.

Wykorzystane biblioteki

W celu wykonania analizy zostało użytych wiele bibliotek:

library(knitr)
library(dplyr)
library(ggplot2)
library(caret)
library(kableExtra)
library(tidyr)
library(tidyverse)
library(plotly)

Powtarzalne wyniki

W celu uzyskania takich samych rezultatów przy ponownych wykonaniach skryptu na tych samych danych, ustalono ziarno na losową liczbę.

set.seed(23)

Wczytanie danych z pliku.

Dane znajdują się w jednym pliku formatu csv - ‘sledzie.csv’. Wartości puste zostały reprezentowane poprzez znak ‘?’.

sledzie_df <- read.csv(
  "sledzie.csv",
  col.names = c("lp", "length", "cfin1", "cfin2", "chel1", "chel2", "lcop1", "lcop2", "fbar", "recr", "cumf", "totaln", "sst", "sal", "xmonth", "nao"),
  na.strings = "?"
)
sledzie_df <- sledzie_df[-c(1)]
sledzie_df <- tbl_df(sledzie_df)

W poniższej tabeli zaprezentowanych zostało kilka pierwszych rekordów zbioru:

length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr cumf totaln sst sal xmonth nao
23.0 0.02778 0.27785 2.46875 NA 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
22.0 0.02778 0.27785 2.46875 21.43548 2.54787 NA 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
23.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8

Obsługa brakujących danych

W celu zapewnienia poprawnych wyników obliczeń, zdecydowano się na usunięcie rekordów zawierających brakujące wartości.

sledzie_df <- na.omit(sledzie_df)
kable(head(sledzie_df, 8)) %>%
  kable_styling("striped") %>%
  scroll_box(height="360px")
length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr cumf totaln sst sal xmonth nao
22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
25.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
25.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
24.0 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
23.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8
22.5 0.02778 0.27785 2.46875 21.43548 2.54787 26.35881 0.356 482831 0.3059879 267380.8 14.30693 35.51234 7 2.8

Rozmiar zbioru i podstawowe statystyki

Po wstępnym przetwarzaniu, zbiór obserwacji śledzi składa się z 42488 rekordów oraz 15 atrybutów.

dim(sledzie_df)
## [1] 42488    15

Podstawowe statystyki dla atrybutów zbioru:

kable(summary(sledzie_df)) %>%
  kable_styling("striped") %>%
  scroll_box(height="425px")
length cfin1 cfin2 chel1 chel2 lcop1 lcop2 fbar recr cumf totaln sst sal xmonth nao
Min. :19.0 Min. : 0.0000 Min. : 0.0000 Min. : 0.000 Min. : 5.238 Min. : 0.3074 Min. : 7.849 Min. :0.0680 Min. : 140515 Min. :0.06833 Min. : 144137 Min. :12.77 Min. :35.40 Min. : 1.000 Min. :-4.89000
1st Qu.:24.0 1st Qu.: 0.0000 1st Qu.: 0.2778 1st Qu.: 2.469 1st Qu.:13.427 1st Qu.: 2.5479 1st Qu.:17.808 1st Qu.:0.2270 1st Qu.: 360061 1st Qu.:0.14809 1st Qu.: 306068 1st Qu.:13.60 1st Qu.:35.51 1st Qu.: 5.000 1st Qu.:-1.90000
Median :25.5 Median : 0.1111 Median : 0.7012 Median : 5.750 Median :21.435 Median : 7.0000 Median :24.859 Median :0.3320 Median : 421391 Median :0.23191 Median : 539558 Median :13.86 Median :35.51 Median : 8.000 Median : 0.20000
Mean :25.3 Mean : 0.4457 Mean : 2.0269 Mean :10.016 Mean :21.197 Mean : 12.8386 Mean :28.396 Mean :0.3306 Mean : 519877 Mean :0.22987 Mean : 515082 Mean :13.87 Mean :35.51 Mean : 7.252 Mean :-0.09642
3rd Qu.:26.5 3rd Qu.: 0.3333 3rd Qu.: 1.7936 3rd Qu.:11.500 3rd Qu.:27.193 3rd Qu.: 21.2315 3rd Qu.:37.232 3rd Qu.:0.4650 3rd Qu.: 724151 3rd Qu.:0.29803 3rd Qu.: 730351 3rd Qu.:14.16 3rd Qu.:35.52 3rd Qu.: 9.000 3rd Qu.: 1.63000
Max. :32.5 Max. :37.6667 Max. :19.3958 Max. :75.000 Max. :57.706 Max. :115.5833 Max. :68.736 Max. :0.8490 Max. :1565890 Max. :0.39801 Max. :1015595 Max. :14.73 Max. :35.61 Max. :12.000 Max. : 5.08000

Szczegółowa analiza wartości atrybutów

length

Interpretacja atrybutu: długość złowionego śledzia [cm]

Podstawowe statystyki:

length <- data.frame(length=sledzie_df$length)
kable(summary(length)) %>%
  kable_styling("striped")
length
Min. :19.0
1st Qu.:24.0
Median :25.5
Mean :25.3
3rd Qu.:26.5
Max. :32.5

W całym zbiorze znajduje się 55 różnych wartości atrybutu.

nrow(distinct(length))
## [1] 55

Histogram rozkładu występowania wartości w zbiorze:

ggplot(length, aes(x=length, fill="#2c7fb8")) + geom_histogram(binwidth = 0.5) + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

cfin1

Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 1]

Podstawowe statystyki:

cfin1 <- data.frame(cfin1=sledzie_df$cfin1)
kable(summary(cfin1)) %>%
  kable_styling("striped")
cfin1
Min. : 0.0000
1st Qu.: 0.0000
Median : 0.1111
Mean : 0.4457
3rd Qu.: 0.3333
Max. :37.6667

W całym zbiorze znajduje się 39 różnych wartości atrybutu.

nrow(distinct(cfin1))
## [1] 39

Histogram rozkładu występowania wartości w zbiorze:

ggplot(cfin1, aes(x=cfin1, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

cfin2

Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus finmarchicus gat. 2]

Podstawowe statystyki:

cfin2 <- data.frame(cfin2=sledzie_df$cfin2)
kable(summary(cfin2)) %>%
  kable_styling("striped")
cfin2
Min. : 0.0000
1st Qu.: 0.2778
Median : 0.7012
Mean : 2.0269
3rd Qu.: 1.7936
Max. :19.3958

W całym zbiorze znajduje się 48 różnych wartości atrybutu.

nrow(distinct(cfin2))
## [1] 48

Histogram rozkładu występowania wartości w zbiorze:

ggplot(cfin2, aes(x=cfin2, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

chel1

Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 1]

Podstawowe statystyki:

chel1 <- data.frame(chel1=sledzie_df$chel1)
kable(summary(chel1)) %>%
  kable_styling("striped")
chel1
Min. : 0.000
1st Qu.: 2.469
Median : 5.750
Mean :10.016
3rd Qu.:11.500
Max. :75.000

W całym zbiorze znajduje się 48 różnych wartości atrybutu.

nrow(distinct(chel1))
## [1] 48

Histogram rozkładu występowania wartości w zbiorze:

ggplot(chel1, aes(x=chel1, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

chel2

Interpretacja atrybutu: dostępność planktonu [zagęszczenie Calanus helgolandicus gat. 2]

Podstawowe statystyki:

chel2 <- data.frame(chel2=sledzie_df$chel2)
kable(summary(chel2)) %>%
  kable_styling("striped")
chel2
Min. : 5.238
1st Qu.:13.427
Median :21.435
Mean :21.197
3rd Qu.:27.193
Max. :57.706

W całym zbiorze znajduje się 51 różnych wartości atrybutu.

nrow(distinct(chel2))
## [1] 51

Histogram rozkładu występowania wartości w zbiorze:

ggplot(chel2, aes(x=chel2, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

lcop1

Interpretacja atrybutu: dostępność planktonu [zagęszczenie widłonogów gat. 1]

Podstawowe statystyki:

lcop1 <- data.frame(lcop1=sledzie_df$lcop1)
kable(summary(lcop1)) %>%
  kable_styling("striped")
lcop1
Min. : 0.3074
1st Qu.: 2.5479
Median : 7.0000
Mean : 12.8386
3rd Qu.: 21.2315
Max. :115.5833

W całym zbiorze znajduje się 48 różnych wartości atrybutu.

nrow(distinct(lcop1))
## [1] 48

Histogram rozkładu występowania wartości w zbiorze:

ggplot(lcop1, aes(x=lcop1, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

lcop2

Interpretacja atrybutu: dostępność planktonu [zagęszczenie widłonogów gat. 2]

Podstawowe statystyki:

lcop2 <- data.frame(lcop2=sledzie_df$lcop2)
kable(summary(lcop2)) %>%
  kable_styling("striped")
lcop2
Min. : 7.849
1st Qu.:17.808
Median :24.859
Mean :28.396
3rd Qu.:37.232
Max. :68.736

W całym zbiorze znajduje się 51 różnych wartości atrybutu.

nrow(distinct(lcop2))
## [1] 51

Histogram rozkładu występowania wartości w zbiorze:

ggplot(lcop2, aes(x=lcop2, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

fbar

Interpretacja atrybutu: natężenie połowów w regionie [ułamek pozostawionego narybku]

Podstawowe statystyki:

fbar <- data.frame(fbar=sledzie_df$fbar)
kable(summary(fbar)) %>%
  kable_styling("striped")
fbar
Min. :0.0680
1st Qu.:0.2270
Median :0.3320
Mean :0.3306
3rd Qu.:0.4650
Max. :0.8490

W całym zbiorze znajduje się 51 różnych wartości atrybutu.

nrow(distinct(fbar))
## [1] 51

Histogram rozkładu występowania wartości w zbiorze:

ggplot(fbar, aes(x=fbar, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

recr

Interpretacja atrybutu: roczny narybek [liczba śledzi]

Podstawowe statystyki:

recr <- data.frame(recr=sledzie_df$recr)
kable(summary(recr)) %>%
  kable_styling("striped")
recr
Min. : 140515
1st Qu.: 360061
Median : 421391
Mean : 519877
3rd Qu.: 724151
Max. :1565890

W całym zbiorze znajduje się 52 różnych wartości atrybutu.

nrow(distinct(recr))
## [1] 52

Histogram rozkładu występowania wartości w zbiorze:

ggplot(recr, aes(x=recr, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

cumf

Interpretacja atrybutu: łączne roczne natężenie połowów w regionie [ułamek pozostawionego narybku]

Podstawowe statystyki:

cumf <- data.frame(cumf=sledzie_df$cumf)
kable(summary(cumf)) %>%
  kable_styling("striped")
cumf
Min. :0.06833
1st Qu.:0.14809
Median :0.23191
Mean :0.22987
3rd Qu.:0.29803
Max. :0.39801

W całym zbiorze znajduje się 52 różnych wartości atrybutu.

nrow(distinct(cumf))
## [1] 52

Histogram rozkładu występowania wartości w zbiorze:

ggplot(cumf, aes(x=cumf, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

totaln

Interpretacja atrybutu: łączna liczba ryb złowionych w ramach połowu [liczba śledzi]

Podstawowe statystyki:

totaln <- data.frame(totaln=sledzie_df$totaln)
kable(summary(totaln)) %>%
  kable_styling("striped")
totaln
Min. : 144137
1st Qu.: 306068
Median : 539558
Mean : 515082
3rd Qu.: 730351
Max. :1015595

W całym zbiorze znajduje się 53 różnych wartości atrybutu.

nrow(distinct(totaln))
## [1] 53

Histogram rozkładu występowania wartości w zbiorze:

ggplot(totaln, aes(x=totaln, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

sst

Interpretacja atrybutu: temperatura przy powierzchni wody [°C]

Podstawowe statystyki:

sst <- data.frame(sst=sledzie_df$sst)
kable(summary(sst)) %>%
  kable_styling("striped")
sst
Min. :12.77
1st Qu.:13.60
Median :13.86
Mean :13.87
3rd Qu.:14.16
Max. :14.73

W całym zbiorze znajduje się 51 różnych wartości atrybutu.

nrow(distinct(sst))
## [1] 51

Histogram rozkładu występowania wartości w zbiorze:

ggplot(sst, aes(x=sst, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

sal

Interpretacja atrybutu: poziom zasolenia wody [Knudsen ppt]

Podstawowe statystyki:

sal <- data.frame(sal=sledzie_df$sal)
kable(summary(sal)) %>%
  kable_styling("striped")
sal
Min. :35.40
1st Qu.:35.51
Median :35.51
Mean :35.51
3rd Qu.:35.52
Max. :35.61

W całym zbiorze znajduje się 51 różnych wartości atrybutu.

nrow(distinct(sal))
## [1] 51

Histogram rozkładu występowania wartości w zbiorze:

ggplot(sal, aes(x=sal, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

xmonth

Interpretacja atrybutu: miesiąc połowu [numer miesiąca]

Podstawowe statystyki:

xmonth <- data.frame(xmonth=sledzie_df$xmonth)
kable(summary(xmonth)) %>%
  kable_styling("striped")
xmonth
Min. : 1.000
1st Qu.: 5.000
Median : 8.000
Mean : 7.252
3rd Qu.: 9.000
Max. :12.000

W całym zbiorze znajduje się 12 różnych wartości atrybutu.

nrow(distinct(xmonth))
## [1] 12

Histogram rozkładu występowania wartości w zbiorze:

ggplot(xmonth, aes(x=xmonth, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

nao

Interpretacja atrybutu: oscylacja północnoatlantycka [mb] Podstawowe statystyki:

nao <- data.frame(nao=sledzie_df$nao)
kable(summary(nao)) %>%
  kable_styling("striped")
nao
Min. :-4.89000
1st Qu.:-1.90000
Median : 0.20000
Mean :-0.09642
3rd Qu.: 1.63000
Max. : 5.08000

W całym zbiorze znajduje się 45 różnych wartości atrybutu.

nrow(distinct(nao))
## [1] 45

Histogram rozkładu występowania wartości w zbiorze:

ggplot(nao, aes(x=nao, fill="#2c7fb8")) + geom_histogram() + theme_minimal() + theme(legend.position = "none") + labs(y="Liczba wystąpień")

Korelacje między zmiennymi

W tabeli przedstawiono korelacje między wszystkimi atrybutami w zbiorze. Jest ona posortowana malejąco od wartości bezwględnej, ponieważ to właśnie ta wielkość świadczy o sile zależności liniowej.
rowname variable correlation
lcop1 chel1 0.9559048
lcop2 chel2 0.8863132
cumf fbar 0.8167639
totaln cumf -0.7083475
lcop2 cfin2 0.6537200
nao lcop1 -0.5508237
nao sst 0.5121196
totaln fbar -0.5081649
nao chel1 -0.5059630
sst length -0.4516706
nao totaln -0.3889789
totaln chel2 -0.3769579
totaln recr 0.3688198
cumf cfin2 0.3377041
chel2 cfin2 0.3080353
totaln lcop2 -0.3041920
cumf lcop2 0.2920843
sst totaln -0.2865169
chel2 chel1 0.2859222
sal recr 0.2790503
totaln lcop1 0.2674522
sst lcop1 -0.2654202
cumf chel2 0.2628982
cumf recr -0.2574990
fbar length 0.2569714
nao length -0.2568447
lcop2 chel1 0.2479366
sst cfin2 -0.2384297
lcop1 length 0.2377540
recr fbar -0.2355175
nao cumf 0.2271715
sal chel2 -0.2237467
chel1 length 0.2209123
totaln cfin2 -0.2183760
sst chel1 -0.2166129
lcop2 cfin1 0.2095303
chel2 cfin1 0.2020157
sst recr -0.1959423
sal lcop2 -0.1866686
sst fbar -0.1808185
lcop1 chel2 0.1748005
totaln chel1 0.1676148
fbar chel1 0.1588357
fbar cfin2 0.1531482
cfin2 cfin1 0.1511962
lcop2 lcop1 0.1502862
sal totaln 0.1491850
sal chel1 -0.1475639
sal cfin1 0.1271426
totaln cfin1 0.1268702
nao sal 0.1243848
lcop1 cfin1 0.1226292
sst lcop2 -0.1197329
recr cfin1 0.1183971
sal cumf -0.1031681
recr cfin2 -0.1017753
sal lcop1 -0.0998841
cfin2 length 0.0983251
totaln length 0.0960581
chel1 cfin1 0.0954064
fbar lcop1 0.0938339
nao recr 0.0928312
sal cfin2 -0.0841898
cfin1 length 0.0812255
xmonth chel2 0.0744084
nao fbar 0.0665154
cumf chel1 0.0656935
xmonth lcop2 0.0649399
fbar cfin1 -0.0641339
nao chel2 -0.0583287
fbar lcop2 0.0524222
lcop2 length 0.0489433
cumf cfin1 -0.0478946
recr chel1 -0.0460700
xmonth chel1 0.0455077
nao lcop2 -0.0445032
lcop1 cfin2 -0.0399855
sal fbar 0.0394580
xmonth cumf 0.0358907
sal length 0.0322355
xmonth lcop1 0.0302401
xmonth totaln -0.0295287
sst cumf 0.0286103
fbar chel2 0.0268957
xmonth sal -0.0253567
xmonth recr 0.0186172
xmonth cfin2 0.0174752
chel2 length -0.0143077
cumf lcop1 -0.0142024
xmonth length 0.0137120
xmonth cfin1 0.0131103
cumf length 0.0115254
sst chel2 0.0104905
sal sst 0.0104314
recr length -0.0103424
sst cfin1 0.0083659
xmonth fbar 0.0082185
nao cfin2 -0.0071064
xmonth sst -0.0068109
nao cfin1 0.0056202
recr lcop1 0.0054818
chel1 cfin2 -0.0033534
recr chel2 0.0013704
nao xmonth -0.0011103
recr lcop2 -0.0005898

Wykres przedstawia graficzną reprezentację powyższej tabeli. Im silniejszy związek, tym ciemniejszy jest kolor na przecięciu dwóch zmiennych.

cor_plot <- data.frame(cor_matrix) %>%
  rownames_to_column() %>%
  pivot_longer(-rowname, names_to="colname") %>%
  ggplot(aes(rowname, colname, fill = value)) + 
  geom_tile() + 
  scale_fill_gradient2() +
  theme(axis.text.x = element_text(angle = 90),
        axis.title.x = element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank()) + coord_flip()
ggplotly(cor_plot)

Warto zwrócić uwagę na pierwszy rząd, reprezentujący korelacje ze zmienną ‘xmonth’, informującą o miesiącu połowu śledzia. Jego korelacja ze wszystkimi innymi atrybutami jest bliska zeru, co świadczy o braku zależności liniowej pomiędzy porą roku, a warunkami występującymi w morzu oraz częstością połowów przez ludzi.

Interaktywny wykres zmiany rozmiaru śledzi w czasie

plot_data <- sledzie_df %>%
  mutate(row_index=1:nrow(sledzie_df) %/% 50) %>%
  group_by(row_index) %>%
  summarise(mean_length=mean(length)) 

p <- ggplot(plot_data, aes(x=row_index, y=mean_length)) + geom_point(aes(alpha=0.01)) + geom_smooth() + labs(x="Upływ czasu", y="Średnia długość") + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank())
ggplotly(p)

Średnia długość śledzia wraz z kolejnymi pomiarami zaczęła najpierw rosnąć, a następnie od około 1/3 do końca pomiarów monotonicznie maleć. Przy tworzeniu wykresu założono, że dane w zbiorze zostały uzupełniane w sposób przyrostowy. W celu uproszczenia wykresu oraz uogólnienia trendu, wykonane zostało uśrednienie wartości długości śledzia dla grup 50 kolejnych śledzi.

Regresor przewidujący rozmiar śledzia

Dane wejściowe zostały podzielone na dane uczące (75%), walidujące i testowe.

inTraining <- createDataPartition(
  y = sledzie_df$length,
  # procent w zbiorze uczącym
  p = .75,
  list = FALSE
)
training <- sledzie_df[inTraining, ]
testing <- sledzie_df[-inTraining, ]

Wykonana została powtórzona ocena krzyżowa.

ctrl <- trainControl(
    # powtórzona ocena krzyżowa
    method = "repeatedcv",
    # liczba podziałów
    number = 2,
    # liczba powtórzeń
    repeats = 5,
    search="random"
)

W budowie regresora zastosowany został algorytm Random forest. Użyta została optymalizacja parametrów w celu uzyskania możliwie najlepszych wyników.

rfGrid <- expand.grid(mtry = 2:5)

fitTune <- train(
  length ~ .,
  data = training,
  method = "rf",
  trControl = ctrl,
  tuneGrid = rfGrid,
  # Paramter dla algorytmu uczącego
  ntree = 30
)

fitTune
## Random Forest 
## 
## 31868 samples
##    14 predictor
## 
## No pre-processing
## Resampling: Cross-Validated (2 fold, repeated 5 times) 
## Summary of sample sizes: 15933, 15935, 15934, 15934, 15934, 15934, ... 
## Resampling results across tuning parameters:
## 
##   mtry  RMSE      Rsquared   MAE      
##   2     1.172179  0.4961002  0.9266149
##   3     1.166325  0.5011428  0.9216823
##   4     1.161063  0.5056256  0.9170422
##   5     1.156562  0.5094468  0.9129805
## 
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 5.

Zgodnie z powyższymi informacjami z wyniku uczenia, wybrany został model dla wartości <> parametru mtry. Miara RMSE oraz R^2 dla zbioru walidującego to odpowiednio: <> oraz <>.

predictions <- predict(fitTune, newdata = testing)
results <- data.frame(predictions=predictions, testing=testing$length)
ggplot(results, aes(x=1:nrow(results), y=testing - predictions)) + geom_point() + labs(x="Kolejne obserwacje w zbiorze testowym", y="Odchylenie od danych testowych")

Po zbudowaniu modelu, został on przetestowany na zbiorze testowym. Powyższy wykres przedstawia różnice między wartością oczekiwaną, a przewidzianą przez algorytm.

errors <- data.frame(errors = results$testing - results$predictions)
ggplot(errors, aes(x=errors)) + geom_histogram(binwidth = 0.25) + labs(x="Różnica", y="Liczność")

Jak możemy zauważyć na kolejnym wykresie, liczność poszczególnych błędów układa się w kształt zbliżony do rozkładu normalnego, ze środkiem w punkcie 0.

total = length(errors[, 1])
mean = mean(errors[, 1])
sd = sd(errors[, 1])

pData <- function(nSD){
  lo = mean - nSD/2*sd
  hi = mean + nSD/2*sd
  percent = sum(errors[, 1]>=lo & errors[, 1]<=hi)/total *100
  percent
}

Procent danych w przedziale jednego, dwóch oraz trzech odchyleń standardowych to odpowiednio: 38%, 69.42% oraz 87.23%.

RMSE(results$predictions, results$testing)
## [1] 1.156587

Miara RMSE dla zbioru testowego to: 1.1565871

rsq <- function(x, y) {
  cor(x, y) ^ 2
}
rsq(results$predictions, results$testing)
## [1] 0.5055137

Miara R^2 dla zbioru testowego to: 0.5055137

Analiza ważności atrybutów najlepszego znalezionego modelu regresji

ggplot(varImp(fitTune))

Ekstraktując ważności atrybutów z modelu, możemy zauważyć że zdecydowanie wyróżniającym się jest sst - temperatura przy powierzchni wody. Kolejnymi zauważalnie większymi od pozostałych są fbar - natężenie połowów w regionie oraz totaln - łączna liczba ryb złowionych w ramach połowu. Intuicja podpowiada nam, że jest to logiczne i uzasadnialne. Wraz ze wzrostem temperatury, zmieniają się parametry środowiska życia śledzi, co może przekładać się na pogorszenie warunkóW ich bytowania i w konsekwencji utrudniony wzrost. Liczba wyłowionych przez ludzi ryb jest również kluczowa, ponieważ śledzie mają mniej czasu na odbudowanie populacji i dorośnięcie do odpowiednich rozmiaróW Pozostałe atrybuty zostały sklasyfikowane jako te, o małym znaczeniu w porównaniu do wcześniej wymienionych.

Poniższe wykresy są porównaniem 3 atrybutów z największym znaczeniem wraz ze średnią długością sledzia. Możemy na nich zauważyć korelacje pomiędzy zmianami wielkości ryb, a pozostałymi zmiennymi.